home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 15
/
Aminet 15 - Nov 1996.iso
/
Aminet
/
comm
/
www
/
HTMLThor.lha
/
HTMLThor.thor
< prev
Wrap
Text File
|
1996-10-01
|
7KB
|
244 lines
/*
** Filename: HTMLThor.thor
**
** $VER: v1.45 (09.30.96)
**
** Author: Troy E. Bouchard
**
** EMail: tbouchar@ptialaska.net
** Webpage: http://www.ptialaska.net/~tbouchar
**
** See HTMLThor.guide for more info.
*/
/* Find our Thor Port and number! */
p = Address() || ' ' || show('P',,)
ThorPort = pos('THOR.',p)
if ThorPort > 0 then ThorPort = word(substr(p,ThorPort),1)
else
do
say "Can't seem to find the Thor port!"
exit 10
End
/* Load the BBSRead library up! */
if ~show('p', 'BBSREAD') then
do
address command
"run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
"WaitForPort BBSREAD"
End
/* change these to match your system! */
TB_WWW = 'A HREF="digest/'
TB_EMail = 'A HREF="mailto:'
TB_MSGPATH = 'T:'
EXT = '.html' /* change this to .htm if you need to. */
/* aint ARexx just great? */
/* change these to your favorite language */
/* Keep the order though! */
TB_WDAYS = 'Monday Tuesday Wednesday Thursday Friday Saturday Sunday'
TB_MONTH = 'January February March April May June July August September October November December'
MDF_DELETED = 5 /* Message is deleted. */
MDF_UNRECOVERABLE = 6 /* Message can not be undeleted. */
/* Remco; start */
SIGNAL ON SYNTAX /* signal the SYNTAX procedure when a syntax error occurs */
SIGNAL ON HALT /* signal the HALT procedure when sys:rexxc/hi is run */
/* Remco; end */
options results
Call GetPages
GetPages:
Address BBSREAD
'GETBBSLIST stem "'BBSLIST'"'
if(rc ~=0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
call cleanup
End
Address(ThorPort)
'REQUESTLIST instem "'BBSLIST'" outstem "'TB_SYSTEM'" title "Selection:" DRAGSELECT MULTISELECT SIZEGADGET'
if(rc ~= 0) then exit
do i=1 to TB_SYSTEM.COUNT
Address BBSREAD
'GETCONFLIST "'TB_SYSTEM.i'" CONFLIST'
if(rc ~= 0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
call cleanup
End
Address(ThorPort)
'REQUESTLIST instem "'CONFLIST'" title "Select conference on ' || TB_SYSTEM.i || ":" ||'" SIZEGADGET'
if(rc ~= 0) then TB_CONFNAME = ""
else TB_CONFNAME = result
MyConf = Translate(TB_CONFNAME,," ","_")
/* Main HTML file */
call open(out, TB_MSGPATH||MyConf||EXT, w)
call writeln(out, "<HTML><HEAD><TITLE>"MyConf||"</TITLE></HEAD>")
call writeln(out, "<BODY><HR><CENTER><H2>"MyConf"</H2><HR>")
call close(out)
Address BBSREAD
'GETCONFDATA BBSName "'TB_SYSTEM.i'" ConfName "'TB_CONFNAME'" Stem CDATA'
if(rc ~= 0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
call cleanup
End
Address(ThorPort)
'OPENPROGRESS TITLE " HTMLThor v1.45" PT "Getting Pages..." AT "_Abort" PCW 30'
if(rc ~= 0) then
do
'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
call cleanup
end
else win = result
msgnumber = 0
do j = CDATA.FIRSTMSG to CDATA.LASTMSG
Drop MsgData.
Drop HeaderInfo.
Drop TextInfo.
Address BBSREAD
'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'j'" DataStem "'MsgData'"'
if(rc ~= 0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
call cleanup
end
if (bittst(MsgData.FLAGS,MDF_DELETED) = 0 & bittst(MsgData.FLAGS, MDF_UNRECOVERABLE) = 0) then
do
msgnumber = msgnumber + 1
Address(ThorPort)
msgtext = 'Saving Page to: 'TB_MSGPATH||MyConf||msgnumber||EXT
'UPDATEPROGRESS REQ "'win'" TOTAL "'CDATA.NUMMESSAGES'" CURRENT "'msgnumber'" PT "'msgtext'"'
if(rc ~= 0) then do
call cleanup
end
Address BBSREAD
'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'j'" TextStem "'TextInfo'" HeadStem "'HeaderInfo'"'
if(rc ~= 0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
call cleanup
end
'AMIGA2DATE "'HeaderInfo.CREATIONDATE'" Stem "'Time'"'
if(rc ~= 0) then
do
NewTime = value('HeaderInfo.CREATIONDATETXT')
Say ''
Say 'OH NO! CREATIONDATE IS SET TO TEXT!'
Say NewTime
Say 'Delete Message nr: 'j' and try again'
call Cleanup
end
if(Time.WDAY == '0') then
WKDays = 'Sunday'
else
WKDays = word(TB_WDAYS, Time.WDAY)
MODays = word(TB_MONTH, Time.MONTH)
if symbol('HeaderInfo.FROMADDR') = "VAR" then
Addr = '<'TB_EMail || value('HeaderInfo.FROMADDR') || '">'
if symbol('HeaderInfo.FROMNAME') = "VAR" then
Nom = value('HeaderInfo.FROMNAME') || '</A>'
if symbol('HeaderInfo.SUBJECT') = "VAR" then
Subj = value('HeaderInfo.SUBJECT')
/* the middle part of the main html */
call open(out, TB_MSGPATH||MyConf||EXT, a)
call writeln(out,'<B>From:</B>'Addr||Nom'<BR><B>Subject:</B><'TB_WWW||MyConf||msgnumber||EXT'">'Subj||'.'||'</A><HR>')
call close(out)
/* the separate parts of the message for the #?.(html|htm) */
call open(out, TB_MSGPATH || MyConf || msgnumber || EXT, w)
call writeln(out, '<HTML><HEAD><TITLE>'MyConf||' - 'Subj||'</TITLE></HEAD>')
call writeln(out, '<BODY><H2><B><CENTER>'MyConf||'</H2>')
call writeln(out, 'Message posted on:<BR>'WKDays' 'MODays' 'Time.MDAY', 'Time.YEAR'</B>')
call writeln(out, '<HR><B>From:</B>'Addr||Nom' ('HeaderInfo.FROMADDR')<BR><B>Subject:</B> 'Subj||'</CENTER>')
call SelectMSG
call close(out)
cnt = value('TextInfo.TEXT.COUNT')
call open(out, TB_MSGPATH||MyConf||msgnumber||EXT, a)
call writeln(out, '<HR><H4>')
if(cnt = 0) then call writeln(out,'No Text</H4><BR>')
else do
do n = 1 to cnt
call writeln(out, value('TextInfo.TEXT.n')'<BR>')
end
end
call writeln(out,'</H4>')
call SelectMSG
call writeln(out,'<HR><CENTER><B>Output created by HTMLThor v1.45<BR>')
call writeln(out,'Written by: Troy E. Bouchard, © 1996</CENTER></B>')
call writeln(out,'<HR></BODY></HTML>')
call close(out)
end
end
/* bottom of main page */
call open(out, TB_MSGPATH||MyConf||EXT, a)
call writeln(out,'<B>Output created by HTMLThor v1.45<BR>')
call writeln(out,'Written by: Troy E. Bouchard, © 1996</B>')
call writeln(out,"<HR></BODY></HTML></CENTER>")
call close(out)
end
Address(ThorPort)
'REQUESTNOTIFY TEXT " We Are Done!\nHTML Files Copied!" BT "_Cool!"'
call cleanup
SelectMSG:
NextMSG = msgnumber + 1
PrevMSG = msgnumber - 1
SELECT
When PrevMSG = 0 then call writeln(out,'<HR><CENTER>| <A HREF="'MyConf||CDATA.NUMMESSAGES||EXT'">Last Message</A> | <A HREF="'MyConf||NextMSG||EXT'">Next Message</A> |</CENTER>')
When NextMSG > CDATA.NUMMESSAGES then call writeln(out,'<HR><CENTER> | <A HREF="'MyConf||PrevMSG||EXT'">Previous Msg</A> | <A HREF="'MyConf||'1'||EXT'">First Message</A> |</CENTER>')
OTHERWISE call writeln(out, '<HR><CENTER>| <A HREF="'MyConf||PrevMSG||EXT'">Previous Message</A> | <A HREF="'MyConf||NextMSG||EXT'">Next Message</A> |</CENTER>')
End
Return
/* Remco Start */
SYNTAX:
SAY 'SYNTAX ERROR'
SAY 'Error 'rc' in line 'sigl': 'errortext(rc)
HALT:
cleanup:
IF (win ~= 0) & SYMBOL('win') = 'VAR' THEN DO
ADDRESS(thorport)
'CLOSEPROGRESS REQ' win
END
EXIT
/* Remco End */